library(stringr)
#setwd("~/Documents/Mineria/Proyecto-Mineria/")
datosIne<-read.csv("mortalidadIne2.csv", header=FALSE, stringsAsFactors=FALSE, fileEncoding="latin1")
#names(datosIne)[1] <- "hola"
names(datosIne)[1] <- "depocu"
names(datosIne)[2] <- "mupocu"  
names(datosIne)[3] <- "sexo"
names(datosIne)[4] <- "diaocu"
names(datosIne)[5] <- "anoreg"
names(datosIne)[6] <- "mesocu"
names(datosIne)[7] <- "edadif"
names(datosIne)[8] <- "ecidif"
names(datosIne)[9] <- "escodif"
names(datosIne)[10] <- "dredif"
names(datosIne)[11] <- "mredif"
names(datosIne)[12] <- "caudef"
#Only letter
datosIne <- datosIne[-1,]
datosIne$caudef <- substr(datosIne$caudef, 1, 1)
datosIne<-filter(datosIne, caudef == "V")
#Eliminate special characters
datosIne$depocu <- str_replace_all(datosIne$depocu, "[^[:alnum:]]", "")
datosIne$mupocu <- str_replace_all(datosIne$mupocu, "[^[:alnum:]]", "")
datosIne$mesocu <- str_replace_all(datosIne$mesocu, "[^[:alnum:]]", "")
datosIne$escodif <- str_replace_all(datosIne$escodif, "[^[:alnum:]]", "")
datosIne$dredif <- str_replace_all(datosIne$dredif, "[^[:alnum:]]", "")
datosIne$mredif <- str_replace_all(datosIne$mredif, "[^[:alnum:]]", "")
#datosIne$caudef > "V00"
#Eliminate (a)
datosIne$ecidif <- str_replace_all(datosIne$ecidif, "\\(a\\)", "")

Descripción de la situación problemática:

Los accidentes de tránsito son la segunda causa de muerte en Guatemala, por detrás de los incidentes que involucran armas de fuego. Diariamente alrededor de 17 accidentes de tránsito deja varios fallecidos según el Instituto Nacional de Ciencias Forenses. A pesar de que los incidentes han disminuido en cantidad durante el plazo 2018 - 2019, la magnitud de los accidentes y la cantidad de muertes solo ha aumentado. En comparación, el año 2019 ha excedido a su predecesor por más de 113 muertes. Las causas varían relacionando a todo tipo de vehiculos, buses de transporte extraurbano, transporte de carga y automóviles livianos. Por lo que se busca determinar el impacto de las crecientes importaciones de vehículos, en este fenómeno.

Objetivos preliminares.

Identificar las condiciones en que estos accidentes de tránsito letales ocurren en mayor consistencia.

Identificar los perfiles de las personas involucradas en los accidentes de tránsito letales.

Identificar las regiones con mayor incidencia de accidentes de tráfico letales.

Determinar si la región con mayor indice de importación coincide con la región de mayor incidencia de accidentes de tránsito letal.

Información a utilizar

Para responder la problemática que se presenta, se utilizaran:

Descripción de Variables:

SAT

La base de datos de defunciones de la SAT, busca almacenar toda la información pertinente en relación a la importación de vehículos al territorio nacional; registrando la mayor cantidad de datos en relación. A continuación se presenta una lista de las variables presentes dentro de este set de datos, además de el valor que representan.

País de Proveniencia (Cualitativa Nominal): País del que proviene el vehículo

Aduana de ingreso (Cualitativa Nominal): Nombre de la aduana en la que el vehículo ingreso

Fecha de la Póliza (Cualitativa Ordinal): Fecha en la que el carro es registrado

Partida Arancelaria (Cuantitativa Discreta): Código de distinción para saber al grupo de pago de impuestos al que pertenece

Modelo del Vehículo (Cualitativa Ordinal): Modelo del vehículo

Marca (Cualitativa Nominal): Marca del vehículo

Línea (Cualitativa Nominal): Linea del vehiculo

Centímetros Cúbicos (Cuantitativa Discreta): Tamaño del motor

Distintivo (Cualitativa Nominal): Distintivo del vehículo

Tipo de Vehículo (Cualitativa Nominal): Tipo de vehículo

Tipo de Importador (Cualitativa Nominal): Tipo de importador (OCASIONAL o DISTRIBUIDOR)

Tipo Combustible (Cualitativa Nominal): Combustible que utiliza el vehículo

Asientos (Cuantitativa Discreta): Número de asientos que tiene el vehiculo

Puertas (Cuantitativa Discreta): Número de puertas que tiene el vehículo

Tonelaje (Cuantitativa Discreta): Peso del vehículo

Valor VIF (Cuantitativa Continua): Costo del vehículo después de haber pagado impuestos

Impuesto (Cuantitativa Continua): Cantidad de impuestos que se debe pagar

En el caso de la SAT, las variables que se utilizarán son País de Proveniencia, Modelo del Vehículo, Marca, Línea, Centímetros Cúbicos, Distintivo, Tipo de Vehículo, Tipo de Combustible, Asientos, Puertas, Tonelaje y Valor CIF. Estas variables se eligieron debido a que luego de identificar las características de los vehículos involucrados en accidentes fatales, se evaluarían sus características en el ámbito de importaciones.

Para el dataset de importaciones de la SAT los procesos de limpieza que se realizaron fueron los siguientes: Se eliminaron todas las filas en las cuales existieran valores nulos para algunos de las columnas. Luego se buscó estandarizar los datos categóricos, asegurando que no existieron caracteres especiales en los diferentes valores. Los valores que se buscaron fueron tildes y signos de puntuación, pero estos no se encontraron ya que todas las variables con caracteres estaban en mayúsculas y sin tildes.

INE

La base de datos de defunciones del INE, busca almacenar toda la información pertinente en relación al deceso de una persona dentro del territorio nacional; registrando la mayor cantidad de datos en relación al suceso. A continuación se presenta una lista de las variables presentes dentro de este set de datos, además de el valor que representan.

Depocu (Cualitativa Nominal): Departamento de registro

Mupocu (Cualitativa Nominal): Municipio de registro

Mesreg (Cualitativa Nominal): Mes de registro

Añoreg (Cualitativa Ordinal): Año de registro

Depocu (Cualitativa Ordinal): Departamento de ocurrencia

Mupocu (Cualitativa Nominal): Municipio de ocurrencia

Sexo (Cualitativa Nominal): Mes de ocurrencia

Añoocu (Cualitativa Ordinal): Año de ocurrencia

Edadif (Cualitativa Ordinal): Edad del difunto

Perdif (Cualitativa Ordinal): Periodo de edad del difunto

Puedif (Cualitativa Ordinal): Pueblo al que pretenece el difunto

Ecidif (Cualitativa Nominal): Estado civil del difunto

Escodif (Cualitativa Nominal): Ecolaridad del difunto

Ciuodif (Cualitativa Nominal): Ocupación del difunto

Pnadif (Cualitativa Nominal): País de nacieminto del equipo

Dnadif (Cualitativa Nominal): Departamento de nacimiento del difunto

Mnadif (Cualitativa Nominal): Municipio del nacimiento del difunto

Nacdif (Cualitativa Nominal): Nacionalidad del difunto

Predif (Cualitativa Nominal): País de recidencia del difunto

Dredif (Cualitativa Nominal): Departamento de recidencia del difunto

Mredif (Cualitativa Nominal): Municipio de recidencia del difunto

Caudef (Cualitativa Nominal): Causa de defunción

Asist (Cualitativa Nominal): Asistencia recibida

Oucr (Cualitativa Nominal): Sitio de ocurrencia

Cerdef (Cualitativa Nominal): Quien certifica

En el caso de Ine, las variables a utilizar serán, depocu, mupocu, sexo, diaocu, añoreg, mesocu, edadif, ecidif, escodif, dredif, mredif, caudef. Esto en primer lugar, gracias a que son variables que se encuentran presentes en todos los datasets año tras año, del 2011 al 2018. Además en variables como la ocupación del difunto el valor indefinido se encuentra repetidas veces por lo que no permite la extracción de información de manera adecuada.

Para el dataset de defunciones del INE los procesos de limpieza que se realizaron fueron los siguientes: Se eliminaron todas las filas en las cuales existieran valores nulos para algunos de las columnas. Luego se buscó estandarizar los datos categóricos, asegurando que no existieron caracteres especiales en los diferentes valores. Los valores que se buscaron fueron tildes y signos de puntuación, que por facilidad se eliminaron en su mayoría desde excel. Además se estandarizó el valor del estado civil, por la existencia de categorías con género y sin género. Por último se seleccionó únicamente los decesos relacionados con incidentes vehiculares.

Tablas de frecuencia de variables elegidas

SAT

Pais de Proveniencia

#Pais de Proveniencia
df <- datos %>%
  group_by(Pais.de.Proveniencia) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df[1:10,]
## # A tibble: 10 x 2
##    Pais.de.Proveniencia  count
##    <chr>                 <int>
##  1 CHINA                666345
##  2 JAPON                324422
##  3 ESTADOS UNIDOS       305488
##  4 INDIA                220345
##  5 COREA DEL SUR         71551
##  6 CANADA                43330
##  7 TAILANDIA             33405
##  8 MEXICO                30150
##  9 ALEMANIA REP. FED.    19166
## 10 BRASIL                14587
ggplot(df[1:10,], aes(x = reorder(Pais.de.Proveniencia,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.3) + theme_pubclean()

Como se puede observar en la gráfica, solo se presentan 10 países, esto se debe a que la cantidad de países dentro de los datos es muy grande para poder graficarlos de tal manera que se pueda identificar los países claramente, por lo cual se eligieron los 10 países con la mayor cantidad de instancias. Se pueden observar los países con la cantidad más grande de instancias de importaciones son China, Japón y Estado Unidos.

Modelo de Vehículo

#Modelo de Vehiculo
df <- datos %>%
  group_by(Modelo.del.Vehiculo) %>%
  summarise(count = n())


df
## # A tibble: 102 x 2
##    Modelo.del.Vehiculo count
##                  <int> <int>
##  1                1900   363
##  2                1910     1
##  3                1911     1
##  4                1918     1
##  5                1921     1
##  6                1922     1
##  7                1923     2
##  8                1924     1
##  9                1925     4
## 10                1926     4
## # … with 92 more rows
ggplot(df, aes(x = Modelo.del.Vehiculo, y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = ""), vjust = -0.5) + theme_pubclean()

hist(datos$Modelo.del.Vehiculo)

Esta gráfica presenta la distribución de el año de modelo de los vehículos, y como se puede observar, la tasa de crecimiento a lo largo de los años ha sido exponencial, de tal manera que la cantidad de importaciones año tras año ha ido incrementando, con últimos 3 años como los que tienen la mayor cantidad.

Marca

#Marca
df <- datos %>%
  group_by(Marca) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Marca,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

En esta gráfica se presenta la distribución de la cantidad de vehículos por marca, tomando en cuenta las 10 marcas con mayor cantidad de filas, donde curiosamente las 3 marcas con la mayor cantidad de instancias son japonesas, y como se pudo ver en el país de proveniencia, también es uno de los países que más apareció.

Linea

#Linea
df <- datos %>%
  group_by(Linea) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Linea,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

Como se puede observar en la gráfica, se presentan las 10 líneas de vehículo con la mayor cantidad de filas que las contienen, y como se puede observar, la que tiene la mayor cantidad es una motocicleta marca Suzuki, la cual aparece casi el doble del segundo lugar.

Centímetros Cúbicos

#Centímetros.Cúbicos
df <- datos %>%
  group_by(Centimetros.Cubicos) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Centimetros.Cubicos,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

Esta gráfica presenta el tamaño del motor del vehículo en centímetros cúbicos, y debido a la gran cantidad de datos, se presentan los 10 tamaños más comunes en el dataset, con el tamaño más común siendo de 125 centímetros cúbicos.

Distintivo

#Distintivo
df <- datos %>%
  group_by(Distintivo) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df
## # A tibble: 3 x 2
##   Distintivo   count
##   <chr>        <int>
## 1 "LIVIANO"  1648624
## 2 "PESADO"    102504
## 3 ""           16291
ggplot(df, aes(x = reorder(Distintivo,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

En esta gráfica se puede observar el distintivo del vehículo, en la cual las 3 posibles categorías son Liviano, Pesado y ninguno de los 2. Claramente la mayor cantidad de vehículos son clasificados como livianos.

Tipo de Vehículo

#Tipo de Vehículo
df <- datos %>%
  group_by(Tipo.de.Vehiculo) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Tipo.de.Vehiculo,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

Como se puede observar en la gráfica, aquí se presenta el tipo de vehículo que se está importando, donde el tipo que más se importa son las motocicletas, siendo casi el triple de la cantidad de automóviles importados. Esto se puede razonar a ser debido a que los precios de moto suelen ser mucho menores a la de los carros, por lo cual es una alternativa que suele elegirse debido a la situación económica de la población.

Tipo de Combustible

#Tipo de Combustible
df <- datos %>%
  group_by(Tipo.Combustible) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df, aes(x = reorder(Tipo.Combustible, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

Esta gráfica muestra el tipo de combustible de los vehículos importados, donde estos pueden utilizar gasolina, Diesel u otros, y se puede ver que los vehículos son principalmente de gasolina.

Asientos

#Asientos
df <- datos %>%
  group_by(Asientos) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Asientos, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

En esta gráfica se puede observar la cantidad de asientos que tiene el vehículo, en las cuales la más común es 2, lo cual podría asumir que es una motocicleta como se vio en las gráficas anteriores, y el siguiente que es de 5, se puede suponer que es un automóvil.

Puertas

#Puertas
df <- datos %>%
  group_by(Puertas) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df, aes(x = reorder(Puertas, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

Como se puede apreciar en esta gráfica se puede observar la cantidad de puertas que tiene el vehículo, en las cuales la más común es 0, lo cual podría asumir que es una motocicleta como se vio en las gráficas anteriores, y el siguiente que es de 4 y 2, se puede suponer que es un automóvil.

Tonelaje

#Tonelaje
df <- datos %>%
  group_by(Tonelaje) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Tonelaje, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

En gráfica muestra el tonelaje del vehículo, en las cuales la más común es 0, lo cual podría asumir que es un vehículo que no necesariamente pese 0 toneladas, sino que menos de 1 tonelada, y el siguiente que es de 1, se puede suponer que es un vehículo más pesado pero del mismo tipo.

Valor CIF

#Valor.CIF
df <- datos %>%
  group_by(Valor.CIF) %>%
  summarise(count = n())
df <- df[order(-df$count),]
hist(df$Valor.CIF)

En esta gráfica se puede observar el Valor CIF de cada vehículo, el cual es el valor real de las mercancías durante el despacho aduanero, en el cual se incluye el costo de las mercancías, el seguro y del flete hasta el puerto de destino.

Año

df <- datos %>%
  group_by(Anio) %>%
  summarise(count = n())
df <- df[order(-df$count),]
ggplot(df, aes(x = reorder(Anio, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

#### Ine

Departamento

#Departamento
df <- datosIne %>%
  group_by(depocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    depocu         count     n
##    <chr>          <int> <dbl>
##  1 Escuintla       1418     1
##  2 Guatemala       1220     2
##  3 Quetzaltenango   812     3
##  4 Peten            702     4
##  5 SantaRosa        692     5
##  6 Izabal           672     6
##  7 Huehuetenango    564     7
##  8 Jutiapa          514     8
##  9 Zacapa           382     9
## 10 Chimaltenango    373    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La tabla de frecuencia muestra la cantidad de decesos registrados por departamento ordenados de forma descendente, para los 10 departamentos con mayor cantidad de decesos. Como se puede observar Escuintla cuenta con el mayor número de decesos, seguido por Guatemala. Como se puede ver en los histogramas , la diferencia entre los primeros dos departamentos y los demás es evidente. Para la cantia posición la cantidad de decesos se redujo a la mitad.

Municipio

#Municipio
df <- datosIne %>%
  group_by(mupocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:20,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 20 x 3
##    mupocu             count     n
##    <chr>              <int> <dbl>
##  1 Guatemala            829     1
##  2 Escuintla            717     2
##  3 Cuilapa              404     3
##  4 Quetzaltenango       321     4
##  5 PuertoBarrios        303     5
##  6 Coatepeque           300     6
##  7 Zacapa               221     7
##  8 SanBenito            212     8
##  9 Jutiapa              205     9
## 10 Morales              191    10
## 11 Mixco                189    11
## 12 Retalhuleu           188    12
## 13 Huehuetenango        186    13
## 14 Tiquisate            174    14
## 15 Chimaltenango        156    15
## 16 Chiquimula           155    16
## 17 Poptiºn              133    17
## 18 SantaCruzdelQuiche   129    18
## 19 Coban                109    19
## 20 Guastatoya            91    20
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por municipio ordenados de forma descendente, para los 10 municipios con mayor cantidad de decesos. Como se puede observar Guatemala cuenta con el mayor número de decesos, seguido por Escuintla. En relación a la gráfica anterior , resalta cómo es que la posición de los departamentos representados cambia en orden. De una misma manera es evidente el descenso exponencial que existe, al moverse de los primeros municipios , a las posiciones medias de la tabla.

Sexo

#Sexo
df <- datosIne %>%
  group_by(sexo) %>%
  summarise(count = n())
df <- df[order(-df$count),]
print(df)
## # A tibble: 2 x 2
##   sexo   count
##   <chr>  <int>
## 1 Hombre  8557
## 2 Mujer   1814
ggplot(df, aes(x = reorder(sexo, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La tabla de frecuencia muestra la cantidad de decesos registrados por sexo. Como se puede ver en los histogramas , la diferencia entre la cantidad de hombres y mujeres es considerable en consideración. La cantidad de hombres es casi 4 veces más que las mujeres.

Día de ocurrencia

#Día de ocurrencia
df <- datosIne %>%
  group_by(diaocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
print(df)
## # A tibble: 10 x 2
##    diaocu count
##    <chr>  <int>
##  1 1        426
##  2 15       391
##  3 25       385
##  4 2        379
##  5 21       364
##  6 3        363
##  7 17       361
##  8 9        361
##  9 22       360
## 10 4        355
ggplot(df, aes(x = reorder(diaocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por día del mes de forma descendente, para los 10 días con mayor cantidad de decesos. Como se puede observar la quincena y el principio de mes, son los días que se presenta una mayor cantidad de decesos. Probablemente relacionado con que ambos días son días de pago. Sin embargo la cantidad no desciende mucho en relación a los demás días como se puede ver en el histograma.

Año de registro

#Año de registro
df <- datosIne %>%
  group_by(anoreg) %>%
  summarise(count = n())
df <- df[order(-df$count),]
print(df)
## # A tibble: 9 x 2
##   anoreg count
##   <chr>  <int>
## 1 2018    3161
## 2 2017    1478
## 3 2014    1249
## 4 2015    1227
## 5 2013    1171
## 6 2012     977
## 7 2011     944
## 8 2019     136
## 9 2016      28
ggplot(df, aes(x = reorder(anoreg, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por año de forma descendiente, para el periodo 2016-2019. Como se puede observar en los histogramas, existe un crecimiento exponencial del año 2017 al 2018. Por lo que se supone que en 2018 existió un mejor registro, en relación a los demás años. Además los años 2016 y 2019, cuentan con valores extremadamente bajos, lo que se puede deber a un mal registro.

Mes de ocurrencia

#Mes de ocurrencia
df <- datosIne %>%
  group_by(mesocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:9,]
print(df)
## # A tibble: 9 x 2
##   mesocu     count
##   <chr>      <int>
## 1 Diciembre   1142
## 2 Marzo        951
## 3 Septiembre   892
## 4 Enero        871
## 5 Noviembre    871
## 6 Abril        841
## 7 Junio        834
## 8 Julio        827
## 9 Febrero      814
ggplot(df, aes(x = reorder(mesocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por mes de forma descendente, para los 9 meses con mayor cantidad de decesos registrados. Como se puede observar diciembre es el mes que cuenta con una mayor cantidad de muertes. Probablemente relacionado con la coincidencia con el periodo de vacaciones. Sin embargo la cantidad no varía mucho entre los meses restantes.

Edad de difuntos

#Edad de difuntos 
df <- datosIne %>%
  group_by(edadif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
print(df)
## # A tibble: 10 x 2
##    edadif count
##    <chr>  <int>
##  1 21       336
##  2 22       323
##  3 24       320
##  4 20       316
##  5 23       315
##  6 25       303
##  7 26       299
##  8 19       287
##  9 28       275
## 10 27       273
ggplot(df, aes(x = reorder(edadif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por edad. Como se puede observar el rango se maneja de 19 a 28 años. Sin existir una gran diferencia. Sin embargo, tomando en cuenta que la mayoría de los primeros valores, pertenecen a la primera mitad del rango. Podríamos afirmar que a medida que la edad aumentan los decesos relacionados con incidentes vehiculares desciende.

Estado civil

#Estado civil
df <- datosIne %>%
  group_by(ecidif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
print(df)
## # A tibble: 4 x 2
##   ecidif   count
##   <chr>    <int>
## 1 Soltero   7062
## 2 Casado    3126
## 3 Ignorado    96
## 4 Unido       87
ggplot(df, aes(x = reorder(ecidif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La siguiente tabla de frecuencia muestra la cantidad de decesos registrados agrupados por el estado civil del difunto. Como se puede observar es evidente que los solteros , son la gran mayoría. Tomando en cuenta la tabla anterior, que la mayoría de decesos esté relacionada con gente jóven, puede dar razón al por qué de esta distribución. Sin embargo también puede estar relacionado a la tasa de matrimonios del país, aunque esto no forma parte del enfoque del estudio.

Escolaridad del difunto

#Escolaridad del difunto
df <- datosIne %>%
  group_by(escodif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
print(df)
## # A tibble: 7 x 2
##   escodif       count
##   <chr>         <int>
## 1 Primaria       3262
## 2 Ninguna        2857
## 3 Diversificado  1670
## 4 Basico         1363
## 5 Ignorado       1027
## 6 Universitario   191
## 7 Postgrado         1
ggplot(df, aes(x = reorder(escodif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La siguiente tabla de frecuencia muestra la cantidad de decesos registrados agrupados por la escolaridad del difunto. Los grupos con menor educación cuentan con las primeras posiciones de la tabla. A pesar de que el grupo Primaria sobrepasa al no que no estudio, esto puede estar relacionado con el mayor acceso que se puede llegar a tener a vehículos. Además manteniendo la misma línea de pensamiento, se puede observar cómo es que tanto los grados universitarios como Postgrado, representan el fondo de la tabla.

Departamento de residencia del difunto

#Departamento de residencia del difunto
df <- datosIne %>%
  group_by(dredif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    dredif         count     n
##    <chr>          <int> <dbl>
##  1 Guatemala       1256     1
##  2 Escuintla        947     2
##  3 Izabal           650     3
##  4 Peten            640     4
##  5 Ignorado         577     5
##  6 Quetzaltenango   571     6
##  7 SantaRosa        556     7
##  8 Huehuetenango    549     8
##  9 Jutiapa          533     9
## 10 SanMarcos        489    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La tabla de frecuencia muestra la cantidad de decesos registrados por departamento de residencia ordenados de forma descendente, para los 10 departamentos de recidencia con mayor cantidad de decesos. Como se puede observar Guatemala cuenta con el mayor número de decesos, seguido por Escuintla, concordando con las tablas del inicio. Sin embargo la diferencia es considerable en comparación.

Municipio de residencia del difunto

#Municipio de residencia del difunto
df <- datosIne %>%
  group_by(mredif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    mredif          count     n
##    <chr>           <int> <dbl>
##  1 Ignorado          577     1
##  2 Guatemala         539     2
##  3 Escuintla         224     3
##  4 PuertoBarrios     212     4
##  5 Morales           210     5
##  6 VillaNueva        159     6
##  7 Mixco             154     7
##  8 Quetzaltenango    152     8
##  9 Jutiapa           142     9
## 10 NuevaConcepciin   132    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

La tabla de frecuencia muestra la cantidad de decesos registrados por departamento de residencia ordenados de forma descendente, para los 10 departamentos de recidencia con mayor cantidad de decesos. Como se puede observar Guatemala cuenta con el mayor número de decesos, seguido por Escuintla, concordando con las tablas del inicio. Sin embargo la diferencia es considerable en comparación.

Clusters SAT

Para poder llevar a cabo un mejor análisis de las variables categóricas del dataset de importaciones de la SAT, se le asignaron valores numéricos a cada instancia única de las variables, para así poder utilizar varias herramientas de análisis como histogramas, mapas de calor, matrices de correlación y otras.

#Convert categorical dataset into numerical categorical
datosSAT<-datos
datosSAT$Pais.de.Proveniencia <- as.numeric(factor(datosSAT$Pais.de.Proveniencia))
datosSAT$Modelo.del.Vehiculo <- as.numeric(factor(datosSAT$Modelo.del.Vehiculo))
datosSAT$Marca <- as.numeric(factor(datosSAT$Marca))
datosSAT$Linea <- as.numeric(factor(datosSAT$Linea))
datosSAT$Distintivo <- as.numeric(factor(datosSAT$Distintivo))
datosSAT$Tipo.de.Vehiculo <- as.numeric(factor(datosSAT$Tipo.de.Vehiculo))
datosSAT$Tipo.Combustible <- as.numeric(factor(datosSAT$Tipo.Combustible))
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cluster)
library(corrplot)
## corrplot 0.84 loaded
library(fpc)
corel <- cor(datosSAT)
corel
##                      Pais.de.Proveniencia Modelo.del.Vehiculo        Marca
## Pais.de.Proveniencia           1.00000000         -0.24393505  0.094645890
## Modelo.del.Vehiculo           -0.24393505          1.00000000 -0.226775905
## Marca                          0.09464589         -0.22677590  1.000000000
## Linea                          0.06201196          0.02515564  0.139939447
## Centimetros.Cubicos            0.23295591         -0.48945617  0.022308648
## Distintivo                     0.02756578         -0.19683647 -0.079659036
## Tipo.de.Vehiculo              -0.18284903          0.25273030  0.012696507
## Tipo.Combustible              -0.18118815          0.03242130  0.051678655
## Asientos                       0.10573900         -0.19358230 -0.003785744
## Puertas                        0.38552552         -0.43346962  0.116152874
## Tonelaje                       0.01996583         -0.14194095 -0.026982811
## Valor.CIF                     -0.13043222          0.35608349 -0.242167156
## Anio                           0.08105821          0.22031249 -0.019055770
## Mes                           -0.02523044          0.00565269 -0.010435640
## Dia                           -0.01328994         -0.02716511  0.019137652
## DiaSem                         0.01274759         -0.08381882  0.016200440
##                             Linea Centimetros.Cubicos   Distintivo
## Pais.de.Proveniencia  0.062011959          0.23295591  0.027565782
## Modelo.del.Vehiculo   0.025155635         -0.48945617 -0.196836468
## Marca                 0.139939447          0.02230865 -0.079659036
## Linea                 1.000000000         -0.05997611 -0.051363140
## Centimetros.Cubicos  -0.059976110          1.00000000  0.556389159
## Distintivo           -0.051363140          0.55638916  1.000000000
## Tipo.de.Vehiculo      0.056075983         -0.47107835 -0.186604021
## Tipo.Combustible      0.048647785         -0.58682580 -0.515317313
## Asientos             -0.058355249          0.33930343  0.278655719
## Puertas              -0.007781753          0.52143580  0.074055662
## Tonelaje             -0.003975428          0.26856365  0.337934617
## Valor.CIF             0.127736347         -0.25362049 -0.044872125
## Anio                  0.038140595         -0.02895566 -0.034637998
## Mes                  -0.024666122         -0.01277855 -0.002211687
## Dia                  -0.005810250          0.02006581 -0.003888485
## DiaSem               -0.020058446          0.06240000  0.015231988
##                      Tipo.de.Vehiculo Tipo.Combustible     Asientos
## Pais.de.Proveniencia     -0.182849031     -0.181188152  0.105739000
## Modelo.del.Vehiculo       0.252730297      0.032421303 -0.193582295
## Marca                     0.012696507      0.051678655 -0.003785744
## Linea                     0.056075983      0.048647785 -0.058355249
## Centimetros.Cubicos      -0.471078353     -0.586825803  0.339303433
## Distintivo               -0.186604021     -0.515317313  0.278655719
## Tipo.de.Vehiculo          1.000000000      0.143207902 -0.331320030
## Tipo.Combustible          0.143207902      1.000000000 -0.310227567
## Asientos                 -0.331320030     -0.310227567  1.000000000
## Puertas                  -0.755618373     -0.186299185  0.341314023
## Tonelaje                 -0.051261927     -0.116938500  0.012548229
## Valor.CIF                 0.304409377      0.009644520 -0.109583642
## Anio                     -0.009056993      0.045764690 -0.001907132
## Mes                       0.029341906      0.006121456 -0.011562311
## Dia                      -0.019637979      0.012247284  0.001547174
## DiaSem                   -0.080476105     -0.002683385  0.032608459
##                           Puertas     Tonelaje    Valor.CIF         Anio
## Pais.de.Proveniencia  0.385525522  0.019965826 -0.130432216  0.081058214
## Modelo.del.Vehiculo  -0.433469623 -0.141940946  0.356083492  0.220312491
## Marca                 0.116152874 -0.026982811 -0.242167156 -0.019055770
## Linea                -0.007781753 -0.003975428  0.127736347  0.038140595
## Centimetros.Cubicos   0.521435803  0.268563653 -0.253620495 -0.028955661
## Distintivo            0.074055662  0.337934617 -0.044872125 -0.034637998
## Tipo.de.Vehiculo     -0.755618373 -0.051261927  0.304409377 -0.009056993
## Tipo.Combustible     -0.186299185 -0.116938500  0.009644520  0.045764690
## Asientos              0.341314023  0.012548229 -0.109583642 -0.001907132
## Puertas               1.000000000  0.003770570 -0.356398367 -0.010947744
## Tonelaje              0.003770570  1.000000000 -0.027094985 -0.021258464
## Valor.CIF            -0.356398367 -0.027094985  1.000000000  0.002640729
## Anio                 -0.010947744 -0.021258464  0.002640729  1.000000000
## Mes                  -0.034108024  0.003293937  0.005790687 -0.147249916
## Dia                   0.014453379  0.008388885 -0.015455646 -0.019179948
## DiaSem                0.091917785  0.007425894 -0.073728941 -0.048655372
##                               Mes           Dia        DiaSem
## Pais.de.Proveniencia -0.025230441 -1.328994e-02  1.274759e-02
## Modelo.del.Vehiculo   0.005652690 -2.716511e-02 -8.381882e-02
## Marca                -0.010435640  1.913765e-02  1.620044e-02
## Linea                -0.024666122 -5.810250e-03 -2.005845e-02
## Centimetros.Cubicos  -0.012778550  2.006581e-02  6.240000e-02
## Distintivo           -0.002211687 -3.888485e-03  1.523199e-02
## Tipo.de.Vehiculo      0.029341906 -1.963798e-02 -8.047610e-02
## Tipo.Combustible      0.006121456  1.224728e-02 -2.683385e-03
## Asientos             -0.011562311  1.547174e-03  3.260846e-02
## Puertas              -0.034108024  1.445338e-02  9.191779e-02
## Tonelaje              0.003293937  8.388885e-03  7.425894e-03
## Valor.CIF             0.005790687 -1.545565e-02 -7.372894e-02
## Anio                 -0.147249916 -1.917995e-02 -4.865537e-02
## Mes                   1.000000000 -5.513890e-03  1.526503e-02
## Dia                  -0.005513890  1.000000e+00  4.976659e-06
## DiaSem                0.015265033  4.976659e-06  1.000000e+00
corrplot(corel)

wcss <- vector()
for(i in 1:10){
  wcss[i] <- sum(kmeans(datosSAT, i)$withinss)
}

ggplot() + geom_point(aes(x = 1:10, y = wcss), color = 'blue') + 
  geom_line(aes(x = 1:10, y = wcss), color = 'blue') + 
  ggtitle("Método del Codo") + 
  xlab('Cantidad de Centroides k') + 
  ylab('WCSS')

Debido a que la cantidad de datos que se encuentra en el dataset de importaciones de la SAT es más de 2 millones de filas con 16 columnas, varios de los métodos de análisis que se implementaron no podían soportar un manejo de datos tan grande por lo cual se tuvo que crear samples del dataset del tamaño más grande que fuera posible para el método. Específicamente para la prueba de la silueta, no se pudo evaluar sobre todos los datos, pero como se puede observar sobre el sample que se obtuvo, el resultado fue consistentemente alrededor de 0.80 por lo cual la clasificación por clustering elegida con K-means fue aceptable definiendo 2 centroides de acuerdo a la gráfica de codo.

k <- kmeans(datosSAT, centers = 2)
p <- fviz_cluster(k, geom = "point", data = datosSAT)+ ggtitle("k = 2")
p

datosSAT$kgroup <- k$cluster
plotcluster(datosSAT[,-c(17)],k$cluster)

sam<-sample(1:nrow(datosSAT),20000)
silkm<-silhouette(datosSAT[sam,"kgroup"],dist(datosSAT[sam,1:16]))
mean(silkm[,3])
## [1] 0.7966865
library(e1071)#para cmeans
library(cluster) #Para calcular la silueta
datosSample <- sample(1:nrow(datosSAT), 10000)
#cmeans
fcm<-cmeans(datosSAT,2)
datosSAT$FCGrupos<-fcm$cluster
#silueta
silfcm<-silhouette(datosSAT[datosSample,"FCGrupos"],dist(datosSAT[datosSample,1:16]))
mean(silfcm[,3])
## [1] 0.800561

###Histogramas de variables SAT por grupo

Modelo del vehiculo

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Modelo.del.Vehiculo"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Modelo.del.Vehiculo"])

Los histogramas anteriores nos muestran como se ve la variable “modelo del vehiculo” en ambos grupos del cluster. En el grupo 1 hay muy pocos carros que sean modelo antes de 2010 y no hay ninguno que sea antes del 2000, mientras que en el grupo 2 hay un poqueño pocentaje de carros que son modelo antes del 2000, los demas estan entre 2000 y 2020.

Marca

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Marca"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Marca"])

Los histogramas anteriores nos muestran como se ve la variable “Marca” en ambos grupos del cluster. En el grupo 1 se puede observar que hay 2 marcas que sobresalen, las cuales son Toyota seguido de Honda. Mientras que en el grupo 2 las 2 que sobre salen es Honda, al igual que en el grupo 1, seguida de Suzuki.

Linea

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Linea"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Linea"])

Los histogramas anteriores nos muestran como se ve la variable “Linea” en ambos grupos del cluster. En el grupo uno la linea que mas se repite es GN125F, mientras que en el grupo 2 la que mas se repite es CGL125.

Centimetros Cubicos

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Centimetros.Cubicos"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Centimetros.Cubicos"])

Los histogramas anteriores nos muestran como se ve la variable “Centimetros cubicos” en ambos grupos del cluster. Como se puede observar la distribucion de ambos grupos esta igual.

Tipo de vehiculo

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Tipo.de.Vehiculo"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Tipo.de.Vehiculo"])

Los histogramas anteriores nos muestran como se ve la variable “tipo de vehiculo” en ambos grupos del cluster. Como se puede ver en ambos grupos el tipo de vehiculo que mas se repite es el mismo, siento este las motocicletas.

Asientos

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Asientos"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Asientos"])

Los histogramas anteriores nos muestran como se ve la variable “Asientos” en ambos grupos del cluster. Como se puede observar la distribucion de ambos grupos esta igual.

Puertas

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Puertas"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Puertas"])

Los histogramas anteriores nos muestran como se ve la variable “Puertas” en ambos grupos del cluster. Como se puede observar la cantidad de puertas que mas se repite es 0, esto se debe a que el tipo de vehiculo que mas se repite en ambos grupos son las motocicletass.

Valor CIF

#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Valor.CIF"])

#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Valor.CIF"])

Los histogramas anteriores nos muestran como se ve la variable “Valor CIF” en ambos grupos del cluster. Como se puede observar el valor que mas se repite en ambos grupos es el 0.

Clusters INE

Con el objetivo de la realización de los clústeres, se convirtieron todos los factores categóricos en factores categóricos numéricos. De esta manera es posible la agrupación por parte de los algoritmos.

#Convert categorical dataset into numerical categorical
datosIneN <- datosIne
datosIneN$depocu <- as.numeric(factor(datosIne$depocu))
datosIneN$mupocu <- as.numeric(factor(datosIne$mupocu))
datosIneN$sexo <- as.numeric(factor(datosIne$sexo))
datosIneN$diaocu <- as.numeric(factor(datosIne$diaocu))
datosIneN$anoreg <- as.numeric(factor(datosIne$anoreg))
datosIneN$mesocu <- as.numeric(factor(datosIne$mesocu))
datosIneN$edadif <- as.numeric(factor(datosIne$edadif))
datosIneN$ecidif <- as.numeric(factor(datosIne$ecidif))
datosIneN$escodif <- as.numeric(factor(datosIne$escodif))
datosIneN$dredif <- as.numeric(factor(datosIne$dredif))
datosIneN$mredif <- as.numeric(factor(datosIne$mredif))
datosIneN$caudef <- as.numeric(factor(datosIne$caudef))

A continuación se presentan las correlaciones que existen entre los diferentes datos:

library(corrplot)
matriz_cor <- cor(datosIneN[-12])
matriz_cor
##               depocu       mupocu         sexo       diaocu       anoreg
## depocu   1.000000000  0.205720208 -0.017256669  0.004702080 -0.030360964
## mupocu   0.205720208  1.000000000 -0.001957212 -0.006488912 -0.014574496
## sexo    -0.017256669 -0.001957212  1.000000000  0.015149855 -0.012559761
## diaocu   0.004702080 -0.006488912  0.015149855  1.000000000 -0.010184627
## anoreg  -0.030360964 -0.014574496 -0.012559761 -0.010184627  1.000000000
## mesocu  -0.006529495  0.047564284  0.024227968  0.004367083 -0.002821199
## edadif   0.031438237  0.016980196  0.083899626 -0.015698844 -0.023512914
## ecidif   0.022607910 -0.026573307  0.011808755  0.009005604  0.017316036
## escodif  0.027410950  0.020503068  0.005634850  0.008957486 -0.044802338
## dredif   0.709138539  0.148679695 -0.035201147  0.009261684 -0.047643705
## mredif   0.020022482  0.430186448 -0.016120104  0.002163981  0.007913470
##                mesocu       edadif        ecidif      escodif       dredif
## depocu  -0.0065294950  0.031438237  0.0226079100  0.027410950  0.709138539
## mupocu   0.0475642844  0.016980196 -0.0265733072  0.020503068  0.148679695
## sexo     0.0242279677  0.083899626  0.0118087555  0.005634850 -0.035201147
## diaocu   0.0043670826 -0.015698844  0.0090056041  0.008957486  0.009261684
## anoreg  -0.0028211987 -0.023512914  0.0173160359 -0.044802338 -0.047643705
## mesocu   1.0000000000 -0.008789969  0.0001362984  0.025936582 -0.018823654
## edadif  -0.0087899685  1.000000000 -0.2354840210  0.218402044  0.029386973
## ecidif   0.0001362984 -0.235484021  1.0000000000 -0.096136139 -0.002995959
## escodif  0.0259365818  0.218402044 -0.0961361391  1.000000000  0.038782148
## dredif  -0.0188236543  0.029386973 -0.0029959590  0.038782148  1.000000000
## mredif   0.0088977228  0.013753846 -0.0462778893  0.037447426  0.068552879
##               mredif
## depocu   0.020022482
## mupocu   0.430186448
## sexo    -0.016120104
## diaocu   0.002163981
## anoreg   0.007913470
## mesocu   0.008897723
## edadif   0.013753846
## ecidif  -0.046277889
## escodif  0.037447426
## dredif   0.068552879
## mredif   1.000000000
 corrplot(matriz_cor)

Como se puede observar, con excepción del departamento de registro de la defunción y el departamento de ocurrencia, las variables son independientes entre sí. Es evidente la razón de la existencia de la relación depocu y dredif, sin embargo es interesante observar como el valor de correlación no es uno. Lo que significa que existe un porcentaje considerable de decesos que se registran en departamentos diferentes.

Se realiza una gráfica de codo para determinar el número de grupos para la realización de los clústeres.

wss <- (nrow(datosIneN[-12])-1)*sum(apply(datosIneN[-12],2,var))

for (i in 2:10) 
  wss[i] <- sum(kmeans(datosIneN[-12], centers=i)$withinss)


plot(1:10, wss, type="b", xlab="Number of Clusters",  ylab="Within groups sum of squares")

Dos es el número indicado.

Se inicia con un clúster con el algoritmo de Kmeans.

#Cluster Kmeans
library(cluster) #Para calcular la silueta
library(fpc)
km<-kmeans(datosIneN[-12],2)
plotcluster(datosIneN[-12],km$cluster)

#Método de la silueta para las k-medias
silkm<-silhouette(km$cluster,dist(datosIneN[-12]))
mean(silkm[,3]) #0.55, no es la mejor partición pero no está mal
## [1] 0.4265287

Kmodes es una variación del algoritmo especifica para variables categoricas, por lo que se realiza esperando un mejor valor de silueta.

#Cluster Kmodes
library(klaR)
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
kmo<-kmodes(datosIneN[-12], 2, iter.max = 10, weighted = FALSE)
## Warning in kmodes(datosIneN[-12], 2, iter.max = 10, weighted = FALSE): data has
## numeric coloumns with more than 30 different levels!
#kmo
plotcluster(datosIneN[-12],kmo$cluster)

#Método de la silueta para las k-medias
silkm<-silhouette(kmo$cluster,dist(datosIneN[-12]))
mean(silkm[,3]) #0.55, no es la mejor partición pero no está mal
## [1] 0.000963793

Al no mejorar se trabaja sobre Kmeans. Se grafican las variables para hacerse una idea de la manera en que están distribuidas respecto a las demás

plotp1 <- datosIneN[-12]
plotp2 <- plotp1[6:11] 
plotp1 <- plotp1[1:6]
plot(plotp1)

plot(plotp2)

Se seleccionan mupocu, sexo, diaocu, mesocu, ecidif y dredif, gracias a que se optiene un mejor valor de silueta.

#datosIneN
dc <-  datosIneN[c(2,3,4,6,8,10)]
km<-kmeans(dc,2)
plotcluster(dc,km$cluster)

silkm<-silhouette(km$cluster,dist(dc))
mean(silkm[,3]) 
## [1] 0.616405

Se prueba Cmeans para ver si mejora la silueta.

#datosIneN
library(e1071)
dc <-  datosIneN[c(2,3,4,6,8,10)]
cm<-cmeans(dc,2)
plotcluster(dc,cm$cluster)

silkm<-silhouette(cm$cluster,dist(dc))
mean(silkm[,3]) 
## [1] 0.6035969

Se cuenta con mejor un mejor agrupamiento. Además se prueba con mixture of gaussians.

#datosIneN
library(mclust)
## Package 'mclust' version 5.4.5
## Type 'citation("mclust")' for citing this R package in publications.
dc <-  datosIneN[c(3,5,6,11)]
mc<-Mclust(dc,2)
plot(mc, what = "classification", main="MClust Classification")

silmg<-silhouette(mc$classification,dist(dc))
mean(silmg[,3])
## [1] 0.6644181

Se prueba con clustering jerárquico.

#datosIneN
library(mclust)
dc <-  datosIneN[c(3,5,6,11)]
hc<-hclust(dist(dc))
plot(hc)
rect.hclust(hc,k=2)

groups<-cutree(hc,k=2)
silch<-silhouette(groups,dist(dc))
mean(silch[,3])
## [1] 0.6675357

Por ser el mejor agrupamiento, este es el clúster seleccionado. A continuación se muestran los grupos formados.

datosIne$grupo <- groups
g1<-datosIne[datosIne$grupo==1,]
g2<-datosIne[datosIne$grupo==2,]

Para el análisis de los clústeres se procedio a generar las tablas de frecuencia e histogramas de todas las varibles, como se muestra acontinuación:

df <- g1 %>%
  group_by(depocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    depocu         count     n
##    <chr>          <int> <dbl>
##  1 Escuintla       1012     1
##  2 Guatemala        902     2
##  3 Quetzaltenango   725     3
##  4 Izabal           639     4
##  5 SantaRosa        555     5
##  6 Peten            538     6
##  7 Jutiapa          442     7
##  8 Huehuetenango    358     8
##  9 Retalhuleu       310     9
## 10 Quiche           251    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(depocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    depocu        count     n
##    <chr>         <int> <dbl>
##  1 Escuintla       406     1
##  2 Guatemala       318     2
##  3 Huehuetenango   206     3
##  4 Chimaltenango   178     4
##  5 Peten           164     5
##  6 Zacapa          143     6
##  7 SantaRosa       137     7
##  8 AltaVerapaz     136     8
##  9 SanMarcos       124     9
## 10 Quiche          122    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(mupocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    mupocu         count     n
##    <chr>          <int> <dbl>
##  1 Guatemala        643     1
##  2 Escuintla        551     2
##  3 Cuilapa          334     3
##  4 PuertoBarrios    293     4
##  5 Coatepeque       288     5
##  6 Quetzaltenango   276     6
##  7 Jutiapa          183     7
##  8 Morales          179     8
##  9 SanBenito        173     9
## 10 Retalhuleu       171    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(mupocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    mupocu                  count     n
##    <chr>                   <int> <dbl>
##  1 Guatemala                 186     1
##  2 Escuintla                 166     2
##  3 Zacapa                    101     3
##  4 Tiquisate                  82     4
##  5 Cuilapa                    70     5
##  6 SantaCruzdelQuiche         68     6
##  7 Chimaltenango              60     7
##  8 Solola                     54     8
##  9 SantaLuciaCotzumalguapa    52     9
## 10 Totonicapan                49    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(sexo) %>%
  summarise(count = n())
df <- df[order(-df$count),]
print(df)
## # A tibble: 2 x 2
##   sexo   count
##   <chr>  <int>
## 1 Hombre  6350
## 2 Mujer   1387
ggplot(df, aes(x = reorder(sexo, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(sexo) %>%
  summarise(count = n())
df <- df[order(-df$count),]
print(df)
## # A tibble: 2 x 2
##   sexo   count
##   <chr>  <int>
## 1 Hombre  2207
## 2 Mujer    427
ggplot(df, aes(x = reorder(sexo, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(diaocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    diaocu count     n
##    <chr>  <int> <dbl>
##  1 1        324     1
##  2 15       300     2
##  3 25       291     3
##  4 2        288     4
##  5 5        278     5
##  6 4        274     6
##  7 3        271     7
##  8 16       269     8
##  9 22       268     9
## 10 17       264    10
ggplot(df, aes(x = reorder(diaocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(diaocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    diaocu count     n
##    <chr>  <int> <dbl>
##  1 9        120     1
##  2 11       103     2
##  3 1        102     3
##  4 21       101     4
##  5 26        99     5
##  6 29        98     6
##  7 17        97     7
##  8 25        94     8
##  9 22        92     9
## 10 3         92    10
ggplot(df, aes(x = reorder(diaocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(anoreg) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 9 x 3
##   anoreg count     n
##   <chr>  <int> <dbl>
## 1 2018    2298     1
## 2 2017    1151     2
## 3 2014     950     3
## 4 2015     911     4
## 5 2013     873     5
## 6 2011     719     6
## 7 2012     708     7
## 8 2019     106     8
## 9 2016      21     9
ggplot(df, aes(x = reorder(anoreg, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(anoreg) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 9 x 3
##   anoreg count     n
##   <chr>  <int> <dbl>
## 1 2018     863     1
## 2 2017     327     2
## 3 2015     316     3
## 4 2014     299     4
## 5 2013     298     5
## 6 2012     269     6
## 7 2011     225     7
## 8 2019      30     8
## 9 2016       7     9
ggplot(df, aes(x = reorder(anoreg, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(mesocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    mesocu     count     n
##    <chr>      <int> <dbl>
##  1 Diciembre    859     1
##  2 Marzo        681     2
##  3 Noviembre    663     3
##  4 Enero        657     4
##  5 Septiembre   639     5
##  6 Julio        636     6
##  7 Junio        634     7
##  8 Abril        612     8
##  9 Febrero      610     9
## 10 Octubre      586    10
ggplot(df, aes(x = reorder(mesocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(mesocu) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    mesocu     count     n
##    <chr>      <int> <dbl>
##  1 Diciembre    283     1
##  2 Marzo        270     2
##  3 Septiembre   253     3
##  4 Abril        229     4
##  5 Enero        214     5
##  6 Noviembre    208     6
##  7 Febrero      204     7
##  8 Mayo         202     8
##  9 Junio        200     9
## 10 Agosto       194    10
ggplot(df, aes(x = reorder(mesocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(edadif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    edadif count     n
##    <chr>  <int> <dbl>
##  1 21       244     1
##  2 24       234     2
##  3 20       233     3
##  4 25       226     4
##  5 23       225     5
##  6 22       224     6
##  7 28       222     7
##  8 26       215     8
##  9 19       213     9
## 10 27       201    10
ggplot(df, aes(x = reorder(edadif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(edadif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    edadif count     n
##    <chr>  <int> <dbl>
##  1 22        99     1
##  2 21        92     2
##  3 23        90     3
##  4 24        86     4
##  5 26        84     5
##  6 20        83     6
##  7 25        77     7
##  8 19        74     8
##  9 27        72     9
## 10 29        69    10
ggplot(df, aes(x = reorder(edadif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(ecidif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 4 x 3
##   ecidif   count     n
##   <chr>    <int> <dbl>
## 1 Soltero   5337     1
## 2 Casado    2250     2
## 3 Ignorado    87     3
## 4 Unido       63     4
ggplot(df, aes(x = reorder(ecidif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(ecidif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 4 x 3
##   ecidif   count     n
##   <chr>    <int> <dbl>
## 1 Soltero   1725     1
## 2 Casado     876     2
## 3 Unido       24     3
## 4 Ignorado     9     4
ggplot(df, aes(x = reorder(ecidif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(escodif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 7 x 3
##   escodif       count     n
##   <chr>         <int> <dbl>
## 1 Primaria       2335     1
## 2 Ninguna        2102     2
## 3 Diversificado  1281     3
## 4 Basico         1013     4
## 5 Ignorado        864     5
## 6 Universitario   141     6
## 7 Postgrado         1     7
ggplot(df, aes(x = reorder(escodif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(escodif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 6 x 3
##   escodif       count     n
##   <chr>         <int> <dbl>
## 1 Primaria        927     1
## 2 Ninguna         755     2
## 3 Diversificado   389     3
## 4 Basico          350     4
## 5 Ignorado        163     5
## 6 Universitario    50     6
ggplot(df, aes(x = reorder(escodif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(dredif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    dredif         count     n
##    <chr>          <int> <dbl>
##  1 Guatemala        890     1
##  2 Izabal           650     2
##  3 Escuintla        647     3
##  4 Ignorado         577     4
##  5 Quetzaltenango   537     5
##  6 Jutiapa          478     6
##  7 Peten            471     7
##  8 SantaRosa        443     8
##  9 Huehuetenango    337     9
## 10 SanMarcos        328    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(dredif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    dredif        count     n
##    <chr>         <int> <dbl>
##  1 Guatemala       366     1
##  2 Escuintla       300     2
##  3 Huehuetenango   212     3
##  4 Chimaltenango   183     4
##  5 AltaVerapaz     175     5
##  6 Peten           169     6
##  7 SanMarcos       161     7
##  8 Zacapa          151     8
##  9 Solola          149     9
## 10 Quiche          135    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g1 %>%
  group_by(mredif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    mredif          count     n
##    <chr>           <int> <dbl>
##  1 Ignorado          577     1
##  2 Guatemala         539     2
##  3 Escuintla         224     3
##  4 PuertoBarrios     212     4
##  5 Morales           210     5
##  6 Mixco             154     6
##  7 Quetzaltenango    152     7
##  8 Jutiapa           142     8
##  9 NuevaConcepciin   132     9
## 10 Coatepeque        119    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

df <- g2 %>%
  group_by(mredif) %>%
  summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
  df[i,]$n <- i
}
print(df)
## # A tibble: 10 x 3
##    mredif                  count     n
##    <chr>                   <int> <dbl>
##  1 VillaNueva                159     1
##  2 SantaLuciaCotzumalguapa   116     2
##  3 Zacapa                     97     3
##  4 SanJose                    81     4
##  5 VillaCanales               81     5
##  6 SanLuis                    72     6
##  7 Sayaxche                   71     7
##  8 SantaCruzdelQuiche         70     8
##  9 TecpanGuatemala            69     9
## 10 Tiquisate                  66    10
ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()

En primer lugar, podemos observar que el Grupo No.1 generado por el clúster es considerablemente más grande que el Grupo No. 2. En una proporción aproximada de 3 a 1. Para las variables sexo, año de ocurrencia, mes de ocurrencia, edad, estado civil y educación, parecería ser que el clúster dividió la frecuencia en proporciones iguales entre los grupos. Por lo que no brinda gran información para generar una diferenciación. Si ignoramos los valores de Guatemala y escuintla, gracias a que cuentan con una mayor frecuencia; pareciera ser que las variables de departamento de ocurrencia, municipio de ocurrencia , departamento de residencia del difunto y municipio de residencia del difunto, dividen el país en regiones diferentes. Por lo que esto puede ser una manera en que se diferencien los grupos. Nombrandolos Región 1 y Región 2. Además en lo que respecta a los días de ocurrencia, pareciera ser que se dividen los días del mes entre los dos grupos. El primer grupo contando con más días de la primera y segunda semana si no se toman en consideración los repetidos. Y el segundo grupo con más días de la tercera y última semana, sino se toman en cuenta los repetidos. Por lo que podría ser otra manera en que se le podría designar a los grupos, Mitad 1 del mes, Mitad 2 del mes.

Hallazgos INE

El objetivo al analizar la base de datos de defunciones del INE fue identificar aquellas muertes que sucedieron a causa de un accidente automovilístico y las condiciones en las que estos ocurrieron. A la vez, se buscó reconocer aquellos datos que se pudieran relacionar con los datos de importación de vehículos de la SAT. Uno de los datos con potencial para identificar estas características, fue la distribución de defunciones según el departamento, ya que se podría razonar que, en aquellos departamentos con mayor población y tráfico vehicular, es mucho más probable que existan defunciones por accidentes. La tasa de crecimiento de decesos por año había sido lineal, hasta que en 2018 mostró crecer de forma exponencial, lo cual se puede atribuir a un mejor registro, pero tiene el potencial de que sea por mayor circulación de vehículos, y como se puede observar en la base de datos de la SAT, la importación de vehículos ha crecido de forma exponencial también. Respecto a las características que aquellos que han fallecido en accidentes automovilísticos, han sido en su gran mayoría adultos jóvenes de alrededor de los 20 años. Esta característica se puede razonar, que es debido al estilo de vida que es común en esas edades, tal como falta de experiencia al conducir, y que conforme aumenta la edad, los decesos se reducen.

Al realizar un análisis de los datos con la gráfica de codo, se decidió que la cantidad ideal de clusters sería 2. Luego de esto se crearon los grupos utilizando los métodos de clustering kmeans, kmodes, cmeans y hclust, realizando la prueba de la silueta para cada resultado. Al realizar la prueba de la silueta se encontró que el método con el mejor resultado fue hclust, por lo cual se utilizará la agrupación creada por este.

Hallazgos SAT

Nuestro objetivo al realizar en análisis de datos sobre la base de datos de importaciones de la SAT era poder identificar tendencias en las características de los vehículos importados. Al analizar esta información se buscará alguna relación existente entre estas características con aquellas identificadas en la base de datos del INE. La relación que se espera encontrar es que aquellos vehículos que están involucrados en mayor cantidad de accidentes de tránsito que resulte en la muerte de las personas, también posean alguna característica evidente en la base de datos de importaciones. Por el momento lo que se han logrado identificar algunas características de los vehículos importados que podrían aportar a los fines de la investigación. Se encontró que el tipo de vehículo que más se importa en Guatemala es la motocicleta, lo cual podría tener alta significancia en el ámbito de defunciones por accidentes automovilísticos, ya que se le suele atribuir a las motocicletas como un medio de transporte más peligroso que otros. Este dato también viene respaldado por las otras variables que también resultaron teniendo las características de una motocicleta como la más común, por ejemplo, el tamaño del motor, la cantidad de asientos, el número de puertas y el peso del vehículo.

Al realizar un análisis con la gráfica de codo, se encontró que la cantidad ideal de clusters a crear serían 2, y se crearon clusters con varios métodos diferentes para identificar cual de todos tenía un mejor resultado en la prueba de la silueta, y se encontró que el mejor método fue kmeans. Se analizaron los 2 grupos creados por kmeans, evaluando las características de cada variable según el grupo al que pertenecían.

Conclusión

En lo que respecta al siguiente paso a seguir, se considera que en base a los hallazgos es posible generar un modelo que auxilie en la determinación de riesgos de accidentes fatales en regiones las condiciones temporales.